home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / dired / dired-chmod.el < prev    next >
Encoding:
Text File  |  1995-08-08  |  6.0 KB  |  173 lines
  1. ;;; dired-chmod.el - interactive editing of file permissions in Dired listings.
  2.  
  3. ;;; Copyright (C) 1995 Russell Ritchie, <Russell.Ritchie@gssec.bt.co.uk>
  4.  
  5. ;; Keywords: dired extensions, faces, interactive chmod
  6.  
  7. ;; This file is part of XEmacs.
  8.  
  9. ;; XEmacs is free software; you can redistribute it and/or modify it
  10. ;; under the terms of the GNU General Public License as published by
  11. ;; the Free Software Foundation; either version 2, or (at your option)
  12. ;; any later version.
  13.  
  14. ;; XEmacs is distributed in the hope that it will be useful, but
  15. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17. ;; General Public License for more details.
  18.  
  19. ;; You should have received a copy of the GNU General Public License
  20. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  21. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  22.  
  23. ;;; To turn this on do: 
  24. ;;;  (require 'dired-chmod)
  25. ;;;  (add-hook 'dired-after-readin-hook 'dired-permissions-highlight)
  26.  
  27. (require 'dired)            ;
  28.  
  29. (defvar dired-permissions-regexp "[-r][-w][-Ssx][-r][-w][-sx][-r][-w][-xst]"
  30.   "Regexp matching the file permissions part of a dired line.")
  31.  
  32. (defvar dired-pre-permissions-regexp "^. [0-9     ]*[-d]"
  33.   "Regexp matching the preamble to file permissions part of a dired line.
  34. This shouldn't match socket or symbolic link lines (which aren't editable).")
  35.  
  36. (or (find-face 'dired-face-permissions)
  37.     (and
  38.      (make-face 'dired-face-permissions)
  39.      (set-face-foreground 'dired-face-permissions '(color . "mediumorchid")
  40.               nil nil 'append)
  41.      (set-face-underline-p 'dired-face-permissions '((mono . t)
  42.                              (grayscale . t)) nil
  43.                              nil 'append)))
  44.  
  45. (defun dired-activate-extent (extent keys fn)
  46.   (let ((keymap (make-sparse-keymap)))
  47.     (while keys
  48.       (define-key keymap (car keys) fn)
  49.       (setq keys (cdr keys)))
  50.     (set-extent-face extent 'dired-face-permissions)
  51.     (set-extent-property extent 'keymap keymap)
  52.     (set-extent-property extent 'highlight t)
  53.     (set-extent-property
  54.      extent 'help-echo
  55.      "Type rsStwx to set file permissions to taste interactively.")))
  56.  
  57. (defun dired-chmod-do-chmod (state)
  58.   (let* ((file (dired-get-filename))
  59.      (operation (concat "chmod" " " state " " file))
  60.      (failure (apply (function dired-check-process)
  61.              operation "chmod" state (list file)))
  62.      (here (point)))
  63.     (dired-do-redisplay)
  64.     (goto-char (+ here 1))
  65.     (dired-make-permissions-interactive)
  66.     (if failure
  67.     (dired-log-summary
  68.      (message "%s: error - type W to see why." operation)))))
  69.  
  70. (defun dired-u-r ()
  71.   (interactive)
  72.   (if (equal (event-key last-command-event) ?r)
  73.       (dired-chmod-do-chmod "u+r")
  74.     (dired-chmod-do-chmod "u-r")))
  75.  
  76. (defun dired-u-w ()
  77.   (interactive)
  78.   (if (equal (event-key last-command-event) ?w)
  79.       (dired-chmod-do-chmod "u+w")
  80.     (dired-chmod-do-chmod "u-w")))
  81.  
  82. (defun dired-u-x ()
  83.   (interactive)
  84.   (let ((key (event-key last-command-event)))
  85.     (cond ((equal key ?s) (dired-chmod-do-chmod "u+s"))
  86.       ((equal key ?S) (dired-chmod-do-chmod "u+S"))
  87.       ((equal key ?x) (dired-chmod-do-chmod "u+x"))
  88.       (t (dired-chmod-do-chmod (cond ((looking-at "s") "u-s")
  89.                      ((looking-at "S") "u-S")
  90.                      ((looking-at "x") "u-x")
  91.                      (t "u-x")))))))
  92.  
  93. (defun dired-g-r ()
  94.   (interactive)
  95.   (if (equal (event-key last-command-event) ?r)
  96.       (dired-chmod-do-chmod "g+r")
  97.     (dired-chmod-do-chmod "g-r")))
  98.  
  99. (defun dired-g-w ()
  100.   (interactive)
  101.   (if (equal (event-key last-command-event) ?w)
  102.       (dired-chmod-do-chmod "g+w")
  103.     (dired-chmod-do-chmod "g-w")))
  104.  
  105. (defun dired-g-x ()
  106.   (interactive)
  107.   (let ((key (event-key last-command-event)))
  108.     (cond ((equal key ?s) (dired-chmod-do-chmod "g+s"))
  109.       ((equal key ?x) (dired-chmod-do-chmod "g+x"))
  110.       (t (dired-chmod-do-chmod (if (looking-at "s") "g-s" "g-x"))))))
  111.  
  112. (defun dired-o-r ()
  113.   (interactive)
  114.   (if (equal (event-key last-command-event) ?r)
  115.       (dired-chmod-do-chmod "o+r")
  116.     (dired-chmod-do-chmod "o-r")))
  117.  
  118. (defun dired-o-w ()
  119.   (interactive)
  120.   (if (equal (event-key last-command-event) ?w)
  121.       (dired-chmod-do-chmod "o+w")
  122.     (dired-chmod-do-chmod "o-w")))
  123.  
  124. (defun dired-o-x ()
  125.   (interactive)
  126.   (let ((key (event-key last-command-event)))
  127.     (cond ((equal key ?s) (dired-chmod-do-chmod "o+s"))
  128.       ((equal key ?t) (dired-chmod-do-chmod "o+t"))
  129.       ((equal key ?x) (dired-chmod-do-chmod "o+x"))
  130.       (t (dired-chmod-do-chmod (cond ((looking-at "s") "o-s")
  131.                      ((looking-at "t") "o-t")
  132.                      ((looking-at "x") "o-x")
  133.                      (t "o-x")))))))
  134.  
  135. (defun dired-make-permissions-interactive ()
  136.   (save-excursion
  137.     (beginning-of-line 0)
  138.     (if (and (re-search-forward dired-pre-permissions-regexp (end-of-line) t)
  139.          (looking-at dired-permissions-regexp))
  140.     (let* ((start (point))
  141.            (u-r-extent (make-extent start (+ start 1)))
  142.            (u-w-extent (make-extent (+ start 1) (+ start 2)))
  143.            (u-x-extent (make-extent (+ start 2) (+ start 3)))
  144.            (g-r-extent (make-extent (+ start 3) (+ start 4)))
  145.            (g-w-extent (make-extent (+ start 4) (+ start 5)))
  146.            (g-x-extent (make-extent (+ start 5) (+ start 6)))
  147.            (o-r-extent (make-extent (+ start 6) (+ start 7)))
  148.            (o-w-extent (make-extent (+ start 7) (+ start 8)))
  149.            (o-x-extent (make-extent (+ start 8) (+ start 9))))
  150.       (dired-activate-extent u-r-extent '(r space) 'dired-u-r)
  151.       (dired-activate-extent u-w-extent '(w space) 'dired-u-w)
  152.       (dired-activate-extent u-x-extent '(s S x space) 'dired-u-x)
  153.       (dired-activate-extent g-r-extent '(r space) 'dired-g-r)
  154.       (dired-activate-extent g-w-extent '(w space) 'dired-g-w)
  155.       (dired-activate-extent g-x-extent '(s x space) 'dired-g-x)
  156.       (dired-activate-extent o-r-extent '(r space) 'dired-o-r)
  157.       (dired-activate-extent o-w-extent '(w space) 'dired-o-w)
  158.       (dired-activate-extent o-x-extent '(s t x space) 'dired-o-x)))))
  159.  
  160. (defun dired-permissions-highlight ()
  161.   (message "Highlighting permissions...")
  162.   (save-excursion
  163.     (goto-char (point-min))
  164.     (while (not (eobp))
  165.       (and (not (eolp))
  166.        (dired-make-permissions-interactive))
  167.       (forward-line 1))
  168.     (message "Highlighting permissions...done")))
  169.  
  170. (provide 'dired-chmod) 
  171.  
  172. ;; dired-chmod.el ends here.
  173.